home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
rehash13.zip
/
REHASH.BAS
next >
Wrap
BASIC Source File
|
1991-11-04
|
10KB
|
320 lines
DECLARE FUNCTION CalcDays% (D$)
DECLARE FUNCTION ValidUser% (U$, WriteIt%)
DECLARE FUNCTION HashTo% (V$, MaxPos%)
'* REHASH.BAS
'*---------------------------------------------------------------------------
'*
'* Quick 'N Dirty utility to auto-size/pack a RBBS users file
'*
'* 11-04-91
'*
ON ERROR GOTO 999
DEFINT A-Z
DIM DaysPerMonth(12)
CONST FALSE = 0
CONST TRUE = -1
OPEN "CONS:" FOR OUTPUT AS #10
PRINT #10, "REHASH v1.30 11-04-91, Super-Dooper RBBS Users File Resizer, by Tom Collins"
PRINT #10,
A$ = COMMAND$
A$ = UCASE$(LTRIM$(RTRIM$(A$)))
ExemptLevel = 32000
I = INSTR(A$, "/EL")
IF I <> 0 THEN
ExemptLevel = VAL(MID$(A$, I + 3))
END IF
OlderThan = 32000
I = INSTR(A$, "/OT")
IF I <> 0 THEN
OlderThan = VAL(MID$(A$, I + 3))
END IF
ExtraUsers = 0
MultiplyFactor! = 1!
I = INSTR(A$, "/MF")
IF I <> 0 THEN
MultiplyFactor! = VAL(MID$(A$, I + 3))
IF MultiplyFactor! < 1! OR MultiplyFactor! > 10! THEN
MultiplyFactor! = 1!
END IF
END IF
IF MultiplyFactor! = 1! THEN
ExtraUsers = 8
END IF
I = INSTR(A$, "/EU")
IF I <> 0 THEN
X = VAL(MID$(A$, I + 3))
IF X > 0 THEN
ExtraUsers = X
END IF
END IF
I = INSTR(A$, "/")
IF I <> 0 THEN
A$ = LEFT$(A$, I - 1)
END IF
I = INSTR(A$, " ")
IF A$ = "" OR I = 0 THEN
PRINT #10, "Usage: REHASH <Messages File> <Users File> [/ELx] [/OTx] [/MFx] [/EUx]"
PRINT #10, " /ELx - Users >= Level x are exempt from packing"
PRINT #10, " /OTx - Remove users who haven't been on in x days"
PRINT #10, " /MFx - Keep file size at least x times what's required (x > 1.0)"
PRINT #10, " /EUx - Leave room for at least x more users"
END
END IF
TempFile$ = "$$USERS$.$$$"
100 MsgsFile$ = RTRIM$(LTRIM$(LEFT$(A$, I)))
OPEN MsgsFile$ FOR RANDOM AS #1 LEN = 128
FIELD 1, 128 AS M$
110 UsersFile$ = RTRIM$(LTRIM$(MID$(A$, I)))
OPEN UsersFile$ FOR RANDOM AS #2 LEN = 128
FIELD 2, 128 AS U$
UserRecs = LOF(2) \ 128
IF MID$(UsersFile$, 2, 1) = ":" THEN
TempFile$ = LEFT$(UsersFile$, 2) + TempFile$
END IF
FOR I = 1 TO 12
DaysPerMonth(I) = 31
NEXT
DaysPerMonth(2) = 28 ' Feb
DaysPerMonth(4) = 30 ' April
DaysPerMonth(6) = 30 ' June
DaysPerMonth(9) = 30 ' Sep
DaysPerMonth(11) = 30 ' Nov
DaysSince88 = CalcDays(LEFT$(DATE$, 6) + RIGHT$(DATE$, 2))
120 PRINT #10, CHR$(254) + " Reading "; UsersFile$; "...";
UsersRecsUsed = 0
TempRecs$ = ""
ForceRehash = FALSE ' v1.30
FOR I = 1 TO UserRecs
GET #2, I
IF ValidUser(U$, WriteIt) THEN
UserRecsUsed = UserRecsUsed + 1
TempRecs$ = TempRecs$ + MKI$(I)
ELSEIF WriteIt = TRUE THEN
PUT #2, I
ForceRehash = TRUE ' v1.30
END IF
NEXT
PRINT #10, UserRecsUsed; "of"; UserRecs; "Records Used."
IF MultiplyFactor! = 1! THEN
UserRecsRequired = UserRecsUsed + ExtraUsers
ELSE
UserRecsRequired = MultiplyFactor! * UserRecsUsed
IF UserRecsRequired - UserRecsUsed < ExtraUsers THEN
UserRecsRequired = UserRecsUsed + ExtraUsers
END IF
END IF
FOR I = 3 TO 15
IF I = 14 THEN
PRINT #10, CHR$(254) + " Can't Rehash... ";
CLOSE 2
GOTO 220
END IF
IF 2 ^ I > UserRecsRequired THEN
UserRecsRequired = 2 ^ I
EXIT FOR
END IF
NEXT
IF UserRecsRequired = UserRecs AND NOT ForceRehash THEN ' v1.30
PRINT #10, CHR$(254) + " No Resizing Required... ";
CLOSE 2
GOTO 220
END IF
130 IF ForceRehash THEN ' v1.30
PRINT #10, CHR$(254) + " Rehashing"; ' v1.30
ELSE ' v1.30
PRINT #10, CHR$(254) + " Resizing"; ' v1.30
END IF ' v1.30
PRINT #10, " File to"; UserRecsRequired; "Records... "; ' v1.30
Recs$ = TempRecs$
OPEN TempFile$ FOR RANDOM AS #3 LEN = 128
FIELD 3, 128 AS T$
140 LSET T$ = SPACE$(128)
150 FOR I = 1 TO UserRecsRequired
PUT 3, I
NEXT
WHILE Recs$ <> ""
I = CVI(LEFT$(Recs$, 2))
Recs$ = MID$(Recs$, 3)
160 GET #2, I
Z$ = U$
X = HashTo(Z$, UserRecsRequired)
IF X = -1 THEN
PRINT #10, "Failed."
170 CLOSE 3
IF UserRecsRequired = 16384 THEN
PRINT #10, CHR$(254) + " Can't Rehash... ";
CLOSE 2
GOTO 220
END IF
UserRecsRequired = UserRecsRequired * 2
GOTO 130
END IF
' PRINT #10, " "; RTRIM$(LEFT$(U$, 31)); ":"; I; "->"; X
180 LSET T$ = Z$
190 PUT 3, X
WEND
CLOSE 2, 3
200 KILL UsersFile$
210 NAME TempFile$ AS UsersFile$
220 GET 1, 1
MID$(M$, 57, 5) = " "
MID$(M$, 57, 5) = STR$(UserRecsUsed)
230 PUT 1, 1
240 CLOSE 1
PRINT #10, "Done."
END
999 IF ERL = 100 THEN
PRINT #10, "Can't Find Messages File '"; MsgsFile$; "'..."
END
ELSEIF ERL = 110 THEN
PRINT #10, "Can't Find Users File '"; UsersFile$; "'..."
END
ELSE
PRINT #10, "Weird Error"; ERR; "at Line"; ERL; "Has Occurred..."
END
END IF
'* CALCDAYS
'*----------------------------------------------------------------------------
'*
'* Calculates the # of days since Jan 1, 1988
'*
'*
FUNCTION CalcDays (D$)
SHARED DaysPerMonth()
Month = VAL(MID$(D$, 1, 2))
Day = VAL(MID$(D$, 4, 2))
Year = VAL(MID$(D$, 7, 2))
IF Year < 88 THEN
Year = 88
END IF
DaysOld = (Year - 88) * 365
IF Month > 1 THEN
FOR I = 1 TO Month - 1
DaysOld = DaysOld + DaysPerMonth(I)
NEXT
END IF
DaysOld = DaysOld + Day
CalcDays = DaysOld
END FUNCTION
'* HASHTO
'*---------------------------------------------------------------------------
'*
'* Returns the user record to put a given user, or -1 if no more room
'*
'*
FUNCTION HashTo (V$, MaxPos)
UserName$ = RTRIM$(LEFT$(V$, 31))
L = LEN(UserName$)
EmptyRec$ = SPACE$(31)
SecondHash = (ASC(MID$(UserName$, 2, 1)) * 10 + 7) MOD MaxPos
PrimeHash = ASC(MID$(UserName$, 1, 1)) * 100
PrimeHash = PrimeHash + ASC(MID$(UserName$, L / 2 + .1, 1)) * 10
PrimeHash = PrimeHash + ASC(RIGHT$(UserName$, 1))
PrimeHash = (PrimeHash MOD MaxPos) + 1
FIELD 3, 128 AS T$
I = PrimeHash
Found = FALSE
FOR Count = 1 TO 25
' IF I <= 0 THEN ' v1.30
' EXIT FOR ' v1.30
' END IF ' v1.30
300 GET 3, I
IF LEFT$(T$, 31) = EmptyRec$ THEN
HashTo = I
Found = TRUE
EXIT FOR
ELSEIF LEFT$(T$, 31) = LEFT$(V$, 31) THEN ' duplicate ' v1.30
Month1 = VAL(MID$(V$, 106, 2))
Month2 = VAL(MID$(T$, 106, 2))
Day1 = VAL(MID$(V$, 109, 2))
Day2 = VAL(MID$(T$, 109, 2))
Year1 = VAL(MID$(V$, 112, 2))
Year2 = VAL(MID$(T$, 112, 2))
IF Year2 > Year1 OR (Year2 = Year1 AND Month2 > Month1) OR (Year2 = Year1 AND Month2 = Month1 AND Day2 > Day1) THEN
V$ = T$
END IF
HashTo = I
Found = TRUE
EXIT FOR
END IF
I = I + SecondHash
IF I > MaxPos - 1 THEN
I = I - MaxPos
WHILE I <= 0 ' v1.30
I = I + SecondHash ' v1.30
WEND ' v1.30
END IF
NEXT
IF NOT Found THEN
HashTo = -1
END IF
END FUNCTION
'* VALIDUSER
'*---------------------------------------------------------------------------
'*
'* Returns TRUE or FALSE depending on whether a given user should
'* be kept in the users file.
'*
FUNCTION ValidUser (U$, WriteIt)
SHARED OlderThan, ExemptLevel
SHARED DaysSince88
B$ = LEFT$(U$, 31)
ValidUser = TRUE
WriteIt = FALSE
IF MID$(B$, 2, 12) = "deleted user" OR LEFT$(B$, 7) = "NEWUSER" THEN
ValidUser = FALSE
MID$(U$, 1, 31) = SPACE$(31)
WriteIt = TRUE
ELSEIF B$ = SPACE$(31) OR B$ = STRING$(31, 0) THEN
ValidUser = FALSE
ELSE
DaysOld = DaysSince88 - CalcDays(MID$(U$, 106, 8))
IF DaysOld > OlderThan THEN
UserSecLevel = CVI(MID$(U$, 47, 2))
IF UserSecLevel < ExemptLevel THEN
ValidUser = FALSE
MID$(U$, 1, 31) = SPACE$(31)
WriteIt = TRUE
END IF
END IF
END IF
END FUNCTION